home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-10-26 | 56.0 KB | 1,337 lines | [ TEXT/PJMM]
unit Stacks; interface uses Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,Resources, Errors, Palettes, QDOffscreen, PictUtils, Timer, globals, Utilities, Graphics, Analysis, Camera, file1, file2, filters, sound, lut; procedure MakeStack; procedure MakeWindowsFromStack; function AddSlice (update: boolean): boolean; procedure DeleteSlice; procedure ShowNextSlice (item: integer); procedure ShowFirstOrLastSlice (ich: integer); procedure DoStackInfo; procedure Reslice; procedure Animate; procedure MakeMovie(ShowDialog: boolean); procedure CaptureFrames; procedure MakeMontage; procedure ConvertRGBToEightBitColor (Capturing: boolean); procedure ConvertEightBitColorToRGB; procedure CaptureColor; procedure AverageSlices; procedure ConvertRGBToHSV; implementation procedure MakeStack; var ok, isStack: boolean; i, result: integer; TempInfo, SaveInfo: InfoPtr; str: str255; begin if not AllSameSize then begin PutError('All currently open images must be the same size to make a stack.'); exit(MakeStack); end; isStack := false; for i := 1 to nPics do begin TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon); isStack := isStack or (TempInfo^.StackInfo <> nil); end; if isStack then begin PutError('All stacks must be closed before making a new stack.'); exit(MakeStack); end; if nPics > MaxSlices then begin NumToString(MaxSlices, str); PutError(concat('Maximun stack size is ', str, ' slices.')); exit(MakeStack); end; StopDigitizing; DisableDensitySlice; SelectWindow(PicWindow[1]); Info := pointer(WindowPeek(PicWindow[1])^.RefCon); ActivateWindow; KillRoi; UnZoom; if not MakeStackFromWindow then exit(MakeStack); with info^ do begin StackInfo^.nSlices := nPics; title := 'Stack'; UpdateTitleBar; Revertable := false; end; SaveInfo := Info; MakingStack := true; ShowWatch; for i := 2 to nPics do begin TempInfo := pointer(WindowPeek(PicWindow[2])^.RefCon); with TempInfo^ do begin hunlock(PicBaseHandle); info^.StackInfo^.PicBaseH[i] := PicBaseHandle; end; result := CloseAWindow(PicWindow[2]); Info := SaveInfo; end; UpdateWindowsMenuItem; MakingStack := false; end; procedure DeleteSlice; var SliceToDelete, NextSlice, i: integer; isRoi: boolean; begin with info^, info^.StackInfo^ do begin if nSlices = 1 then begin WhatToUndo := NothingToUndo; exit(DeleteSlice); end; isRoi := RoiShowing; if isRoi then KillRoi; SetupUndo; WhatToUndo := UndoSliceDelete; SliceToDelete := CurrentSlice; if CurrentSlice = 1 then begin NextSlice := 2; WhatToUndo := UndoFirstSliceDelete; end else NextSlice := CurrentSlice - 1; SelectSlice(NextSlice); UpdatePicWindow; DisposeHandle(PicBaseH[SliceToDelete]); for i := SliceToDelete to nSlices - 1 do PicBaseH[i] := PicBaseH[i + 1]; nSlices := nSlices - 1; if CurrentSlice <> 1 then CurrentSlice := CurrentSlice - 1; if (StackType = rgbStack) and (nSlices <> 3) then StackType := VolumeStack; UpdateTitleBar; if isRoi then RestoreRoi; changes := true; UpdateWindowsMenuItem; end; end; procedure MakeWindowsFromStack; var i, ignore: integer; N: LongInt; SaveInfo: InfoPtr; tmp: longint; function MakeName (i: integer): str255; var str: str255; begin RealToString(i, 3, 0, str); if str[1] = ' ' then str[1] := '0'; if str[2] = ' ' then str[2] := '0'; MakeName := str; end; begin N := info^.StackInfo^.nSlices; tmp := SizeOf(PicInfo); if MaxBlock < (MinFree + info^.ImageSize + (SizeOf(PicInfo) + 2000) * N) then begin PutError('There is not enough memory available to convert this stack to windows.'); exit(MakeWindowsFromStack); end; SaveInfo := Info; KillRoi; for i := 1 to N - 1 do begin SelectSlice(1); info^.StackInfo^.CurrentSlice := 1; if not Duplicate(MakeName(i), false) then exit(MakeWindowsFromStack); info := SaveInfo; DeleteSlice; end; if Duplicate(MakeName(N), false) then begin info := SaveInfo; info^.changes := false; ignore := CloseAWindow(info^.wptr); end; end; procedure ShowNextSlice (item: integer); var isRoi: boolean; begin with info^, info^.StackInfo^ do begin if item = NextSliceItem then begin CurrentSlice := CurrentSlice + 1; if CurrentSlice > nSlices then CurrentSlice := nSlices; end else begin CurrentSlice := CurrentSlice - 1; if CurrentSlice < 1 then CurrentSlice := 1; end; isRoi := RoiShowing; if isRoi then KillRoi; SelectSlice(CurrentSlice); UpdatePicWindow; UpdateTitleBar; WhatToUndo := NothingToUndo; isInsertionPoint:=false; if isRoi then RestoreRoi; end; end; procedure ShowFirstOrLastSlice (ich: integer); var isRoi: boolean; begin with info^, info^.StackInfo^ do begin if ich = EndKey then CurrentSlice := nSlices else CurrentSlice := 1; isRoi := RoiShowing; if isRoi then KillRoi; SelectSlice(CurrentSlice); UpdatePicWindow; UpdateTitleBar; WhatToUndo := NothingToUndo; isInsertionPoint:=false; if isRoi then RestoreRoi; end; end; procedure GetSlice (xstart, ystart, start: extended; angle: extended; count: integer; var line: LineType); var i: integer; x, y, xinc, yinc: extended; IntegerStart: boolean; begin IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart)); if IntegerStart and (angle = 0.0) then begin GetLine(trunc(xstart), trunc(ystart), count, line); exit(GetSlice); end; if IntegerStart and (angle = 270.0) then begin GetColumn(trunc(xstart), trunc(ystart), count, line); exit(GetSlice); end; angle := (angle / 180.0) * pi; xinc := cos(angle); yinc := -sin(angle); x := xstart + start * xinc; y := ystart + start * yinc; for i := 0 to count - 1 do begin line[i] := round(GetInterpolatedPixel(x, y)); x := x + xinc; y := y + yinc; end; end; function DoResliceOptions: boolean; var default, tmp: extended; Canceled: boolean; prompt, str: str255; begin with info^.StackInfo^, info^ do begin if SpatiallyCalibrated then begin default := SliceSpacing / xScale; str := xUnit; end else begin default := SliceSpacing; str := 'pixels'; end; if SliceSpacing = 0.0 then default := 1.0; tmp := GetReal(concat('Slice Spacing (', str, '):'), default, 2, Canceled); if not Canceled and (tmp > 0.0) then begin if SpatiallyCalibrated then SliceSpacing := tmp * xScale else SliceSpacing := tmp; end; end; {with} DoResliceOptions := not canceled; end; procedure Reslice; var DstWidth, DstHeight, nSlices: integer; dstLeft, dstTop, y, i, j, LineLength: integer; SaveWindowFlag, SaveMacro, HorizontalMode: boolean; SaveHScale, SaveVScale, UncalibratedLineLength, CalibratedLineLength, angle: extended; Stack, Reconstruction: InfoPtr; aLine: LineType; name, str1, str2: str255; MaskRect: rect; x1, y1, x2, y2, ulength, clength: extended; procedure MakeRoi (Left, Top, Width, Height: integer); begin with info^ do begin RoiType := RectRoi; SetRect(RoiRect, left, top, left + width, top + height); MakeRegion; SetupUndo; RoiShowing := true; end; end; begin with info^, info^.StackInfo^ do begin if nSlices < 2 then begin PutError('Reslicing requires at least 2 slices.'); AbortMacro; exit(Reslice); end; if not (RoiShowing and (RoiType = LineRoi)) then begin PutError('Please make a straight line selection first.'); AbortMacro; exit(Reslice); end; Stack := info; GetLengthOrPerimeter(ulength, clength); LineLength := round(ulength); if LineLength = 0 then begin PutError('Line length cannot be zero.'); AbortMacro; exit(Reslice); end; if SliceSpacing = 0.0 then if not DoResliceOptions then og: DialogPtr; item, i: integer; FramesPerSecond: extended; procedure ShowFrameRate; begin if SecondsPerFrame = 0.0 then begin if fgWidth = 640 then FramesPerSecond := 30.0 else FramesPerSecond := 25.0 end else FramesPerSecond := 1.0 / SecondsPerFrame; if FramesPerSecond = trunc(FramesPerSecond) then SetDReal(MyLog, rateID, FramesPerSecond, 0) else SetDReal(MyLog, rateID, FramesPerSecond, 4); end; procedure ShowInterval; begin if SecondsPerFrame < 1.0 then SetDReal(MyLog, IntervalID, SecondsPerFrame, 4) else if SecondsPerFrame < 99.0 then SetDReal(MyLog, IntervalID, SecondsPerFrame, 2) else SetDReal(MyLog, IntervalID, SecondsPerFrame, 0); end; procedure ShowTriggerMode; begin SetDlogItem(mylog, TriggerID, ord(ExternalTrigger)); SetDlogItem(mylog, TriggerFirstID, ord(TriggerFirstFrameOnly)); SetDlogItem(mylog, TriggerEachID, ord(not TriggerFirstFrameOnly)); end; begin InitCursor; mylog := GetNewDialog(230, nil, pointer(-1)); SetDNum(MyLog, FramesID, FramesWanted); ShowFrameRate; ShowInterval; SetDlogItem(mylog, BlindID, ord(BlindMovieCapture)); SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture)); SetDlogItem(mylog, StampID, ord(TimeStamp)); ShowTriggerMode; SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack)); SelectDialogItemText(MyLog, FramesID, 0, 32767); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = FramesID then FramesWanted := GetDNum(MyLog, FramesID); if item = IntervalID then begin SecondsPerFrame := GetDReal(MyLog, IntervalID); ShowFrameRate; end; if item = rateID then begin FramesPerSecond := GetDReal(MyLog, rateID); if FramesPerSecond <> 0.0 then SecondsPerFrame := 1.0 / FramesPerSecond; ShowInterval; end; if item = BlindID then begin BlindMovieCapture := not BlindMovieCapture; SetDlogItem(mylog, BlindID, ord(BlindMovieCapture)); end; if item = LG3BufferID then begin LG3BufferCapture := not LG3BufferCapture; if LG3BufferCapture then BlindMovieCapture := true; SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture)); SetDlogItem(mylog, BlindID, ord(BlindMovieCapture)); end; if item = StampID then begin TimeStamp := not TimeStamp; SetDlogItem(mylog, StampID, ord(TimeStamp)); end; if item = TriggerID then begin ExternalTrigger := not ExternalTrigger; SetDlogItem (mylog, TriggerID, ord (ExternalTrigger)); end; if (item = TriggerFirstID) or (item = TriggerEachID) then begin TriggerFirstFrameOnly := not TriggerFirstFrameOnly; ExternalTrigger := true; ShowTriggerMode; end; if item = UseExistingStackID then begin UseExistingStack := not UseExistingStack; SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack)); end; until (item = ok) or (item = cancel); DisposeDialog(mylog); if FramesWanted < 1 then FramesWanted := 1; if FramesWanted > MaxSlices then FramesWanted := MaxSlices; if SecondsPerFrame < 0.0 then SecondsPerFrame := 0.0; if LG3BufferCapture and (item <> cancel) then begin if FrameGrabber <> ScionLG3 then begin LG3BufferCapture := false; PutError('Capturing to an on-board frame buffer requires a Scion LG-3.'); DoMakeMovieOptions := false; exit(DoMakeMovieOptions); end; if FramesWanted > MaxLG3Frames then begin FramesWanted := MaxLG3Frames; PutError(concat('This ', long2str(MaxLG3Frames div 2), 'MB LG-3 can capture a maximum of ', long2str(MaxLG3Frames), ' frames to its on-board buffer.')); DoMakeMovieOptions := false; exit(DoMakeMovieOptions); end; end; DoMakeMovieOptions := item <> cancel; end; procedure CaptureFramesUsingTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect); var StartTicks, NextTicks, LastTicks, interval, ticks: LongInt; SourcePixMap: PixMapHandle; str: str255; frame, i: integer; ElapsedTime, avgFrameInterval: extended; begin interval := round(60.0 * SecondsPerFrame); ShowWatch; SourcePixMap := fgPixMap; ResetFrameGrabber; ShowTriggerMessage; with info^, info^.StackInfo^ do begin if Interval >= 30 then ShowMessage(CmdPeriodToStop) else DrawLabels('Frame:', 'Total:', ''); if TimeStamp then begin SetPort(GrafPtr(osPort)); TextFont(Monaco); TextSize(9); end; for frame := 1 to nFrames do begin CurrentSlice := frame; SelectSlice(CurrentSlice); if Interval >= 30 then UpdateTitleBar else Show2Values(CurrentSlice, nSlices); GetFrame; ticks:=TickCount; if (frame = 1) then begin StartTicks := ticks; NextTicks := StartTicks+interval - 3; if TriggerFirstFrameOnly then ExternalTrigger := false; end else NextTicks := NextTicks + interval; if frame = nFrames then LastTicks := ticks; CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); if TimeStamp then begin ElapsedTime:=(ticks-StartTicks) / 60.0; RealToString(ElapsedTime, 9, 3, str); for i:=1 to 5 do if str[i]=' ' then str[i]:='0'; MoveTo(2,10); DrawString(str); PlotData^[frame]:=ElapsedTime; end; if not BlindMovieCapture then UpdatePicWindow; while TickCount < NextTicks do if CommandPeriod then begin beep; wait(60); exit(CaptureFramesUsingTicks); end; end; {for} ElapsedTime := (LastTicks - StartTicks) / 60.0; avgFrameInterval := ElapsedTime / (nFrames - 1); FrameInterval := avgFrameInterval; end; {with} end; function uTickCount:extended; var count:UnsignedWide; d:extended; begin microseconds(count); d:=count.lo; if d<0 then d:=band(count.lo,$7fffffff)+2147483648.0; uTickCount:=d+count.hi*4294967296.0; end; procedure CaptureFramesUsingMicroTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect); var uStartTicks, uNextTicks, uLastTicks, uInterval, uTicks: Extended; SourcePixMap: PixMapHandle; str: str255; frame, i: integer; ElapsedTime: extended; uTicksToCaptureOneFrame, avgFrameInterval:extended; ShowProgress: boolean; begin ShowWatch; uInterval := 1000000.0 * SecondsPerFrame; SourcePixMap := fgPixMap; ResetFrameGrabber; ShowTriggerMessage; if fgWidth = 768 then {if PAL board} uTicksToCaptureOneFrame := 40000.0 {PAL captures 25 fps} else uTicksToCaptureOneFrame := 33333.0; {non-PAL captures 33 fps} ShowProgress := (not LG3BufferCapture) or (uInterval > (2 * uTicksToCaptureOneFrame)); with info^, info^.StackInfo^ do begin if ShowProgress and (uInterval < 500000.0) then DrawLabels('Frame:', 'Total:', '') else if not ExternalTrigger then ShowMessage(CmdPeriodToStop); if TimeStamp then begin SetPort(GrafPtr(osPort)); TextFont(Monaco); TextSize(9); end; for frame := 1 to nFrames do begin CurrentSlice := frame; SelectSlice(CurrentSlice); if showProgress then begin if uInterval >= 500000.0 then UpdateTitleBar else Show2Values(CurrentSlice, nSlices); end; if LG3BufferCapture then begin BufferReg^ := frame - 1; GetFrame; uTicks := uTickCount; end else begin GetFrame; uTicks := uTickCount; CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); end; if frame = 1 then begin uStartTicks := uTicks; uNextTicks := uStartTicks + uInterval - 1.5 * uTicksToCaptureOneFrame; if TriggerFirstFrameOnly then ExternalTrigger := false; end else uNextTicks :=uNextTicks + uInterval; if frame = nFrames then uLastTicks := uTicks; if TimeStamp then begin ElapsedTime:=(uTicks-uStartTicks) / 1000000.0; PlotData^[frame]:=ElapsedTime; if not LG3BufferCapture then begin RealToString(ElapsedTime, 9, 3, str); for i:=1 to 5 do if str[i]=' ' then str[i]:='0'; MoveTo(2,10); DrawString(str); end; end; if not BlindMovieCapture then UpdatePicWindow; if uTicks < uNextTicks then while uTickCount < uNextTicks do if CommandPeriod then begin beep; wait(60); exit(CaptureFramesUsingMicroTicks); end; end; {for} ElapsedTime := (uLastTicks - uStartTicks) / 1000000.0; avgFrameInterval := ElapsedTime / (nFrames - 1); FrameInterval := avgFrameInterval; end; {with} if LG3BufferCapture then begin {Copy captured frames from LG-3 to stack.} with info^, info^.StackInfo^ do begin for frame := 1 to nFrames do begin ShowAnimatedWatch; CurrentSlice := frame; SelectSlice(CurrentSlice); BufferReg^ := frame - 1; CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); if TimeStamp then begin RealToString(PlotData^[frame], 9, 3, str); for i:=1 to 5 do if str[i]=' ' then str[i]:='0'; MoveTo(2,10); DrawString(str); end; {if TimeStamp} end; {for} end; {with} BufferReg^ := 0; end; {if LG3BufferCapture} end; procedure MakeMovie(ShowDialog: boolean); var nFrames, wleft, wtop, width, height: integer; ignore, SaveFW: integer; OutOfMemory: boolean; seconds: extended; frect: rect; Canceled: boolean; avgFrameInterval: extended; begin SelectCameraWindow; with info^ do begin if PictureType <> FrameGrabberType then begin PutError('You must be capturing to make a movie.'); exit(MakeMovie); end; StopDigitizing; if not (RoiShowing and (RoiType = RectRoi)) then begin PutError('Please make a rectangular selection first.'); exit(MakeMovie); end; if NotInBounds then exit(MakeMovie); if ShowDialog then if not DoMakeMovieOptions then begin AbortMacro; exit(MakeMovie); end; if (FrameGrabber <> ScionLG3) then LG3BufferCapture := false; if LG3BufferCapture and (FramesWanted > MaxLG3Frames) then FramesWanted := MaxLG3Frames; if LG3BufferCapture then BlindMovieCapture := true; with RoiRect do begin left := band(left + 1, $fffc); {Word align} right := band(right + 2, $fffc); if right > PicRect.right then right := PicRect.right; MakeRegion; wleft := left; wtop := top; width := right - left; height := bottom - top; end; end; {with info^} with frect do begin left := wleft; top := wtop; right := left + width; bottom := top + height; end; if UseExistingStack then begin if not Activate('Movie') then begin PutError('Can''t find a stack named "Movie".'); UseExistingStack := false; AbortMacro; exit(MakeMovie); end; with info^ do begin if (PixelsPerLine <> width) or (nLines <> height) then begin PutError('The dimensions of the stack "Movie" are not the same as the selection.'); exit(MakeMovie); end; nFrames := StackInfo^.nSlices; if nFrames > FramesWanted then nFrames := FramesWanted; end {with info} end else begin if not NewPicWindow('Movie', width, height) then exit(MakeMovie); if not MakeStackFromWindow then exit(MakeMovie); nFrames := 1; OutOfMemory := false; while (nFrames < FramesWanted) and (not OutOfMemory) do begin OutOfMemory := not AddSlice(false); if not OutOfMemory then nFrames := nFrames + 1; end; end; if ExternalTrigger and not TriggerFirstFrameOnly then SecondsPerFrame := 0.0; If (FramesWanted < 1) then FramesWanted := 1; if SecondsPerFrame < 0.0 then SecondsPerFrame := 0.0; with info^.StackInfo^ do begin FrameInterval := 0.0; StackType := movieStack; end; if OptionKeyWasDown then CaptureFramesUsingTicks(SecondsPerFrame, nFrames, frect) else CaptureFramesUsingMicroTicks(SecondsPerFrame, nFrames, frect); ShowFirstOrLastSlice(HomeKey); avgFrameInterval := info^.StackInfo^.FrameInterval; if AvgFrameInterval <> 0.0 then ShowMessage(StringOf(nFrames:1, ' frames', cr, AvgFrameInterval * nFrames:1:2, ' seconds', cr, adjustinc then inc := 0; repeat if adjustinc then inc := inc + 1; n := trunc(slices / inc); tmp := sqrt(n); if trunc(tmp) <> tmp then tmp := trunc(tmp) + 1.0; nColumns := trunc(tmp); nRows := nColumns; if (nColumns * (nRows - 1)) >= n then nRows := nRows - 1; xxScale := (MaxWidth / nColumns) / StackWidth; yyScale := (MaxHeight / nRows) / StackHeight; if xxScale < yyScale then scale := xxScale else scale := yyScale; if scale > 1.0 then scale := 1.0; SaveScale := scale; until (scale >= 0.5) or (inc >= 3) or not adjustinc; end; begin InitCursor; with info^ do begin StackWidth := PixelsPerLine; StackHeight := nLines; FirstSlice := 1; TotalSlices := StackInfo^.nSlices; LastSlice := TotalSlices; end; MaxWidth := ScreenWidth - 85; MaxHeight := ScreenHeight - 45; Estimate(scale, true); IncrementSet := false; mylog := GetNewDialog(150, nil, pointer(-1)); SetDNum(MyLog, RowsID, nRows); SetDNum(MyLog, ColumnsID, nColumns); SetDReal(MyLog, ScaleID, scale, 2); SetDNum(MyLog, FirstID, FirstSlice); SetDNum(MyLog, LastID, LastSlice); SetDNum(MyLog, IncrementID, inc); SetDlogItem(MyLog, NumberID, ord(gNumberSlices)); SetDlogItem(MyLog, BordersID, ord(gBorders)); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = ColumnsID then begin nColumns := GetDNum(MyLog, ColumnsID); if nColumns < 0 then begin nColumns := 0; SetDNum(MyLog, ColumnsID, nRows); end; end; if item = RowsID then begin nRows := GetDNum(MyLog, RowsID); if nRows < 0 then begin nRows := 0; SetDNum(MyLog, RowsID, nRows); end; end; if item = ScaleID then scale := GetDReal(MyLog, ScaleID); if item = FirstID then begin FirstSlice := GetDNum(MyLog, FirstID); if (FirstSlice < 1) or (FirstSlice > LastSlice) then FirstSlice := 1; if IncrementSet then Estimate(scale, false) else Estimate(scale, true); SetDNum(MyLog, RowsID, nRows); SetDNum(MyLog, ColumnsID, nColumns); SetDReal(MyLog, ScaleID, scale, 2); end; if item = LastID then begin LastSlice := GetDNum(MyLog, LastID); if (LastSlice < FirstSlice) or (LastSlice > TotalSlices) then LastSlice := TotalSlices; if IncrementSet then Estimate(scale, false) else Estimate(scale, true); SetDNum(MyLog, RowsID, nRows); SetDNum(MyLog, ColumnsID, nColumns); SetDReal(MyLog, ScaleID, scale, 2); end; if item = IncrementID then begin inc := GetDNum(MyLog, IncrementID); IncrementSet := true; if (inc < 1) or (inc > (slices div 2)) then begin inc := 1; SetDNum(MyLog, IncrementID, inc); end; Estimate(scale, false); SetDNum(MyLog, RowsID, nRows); SetDNum(MyLog, ColumnsID, nColumns); SetDReal(MyLog, ScaleID, scale, 2); end; if item = NumberID then begin gNumberSlices := not gNumberSlices; SetDlogItem(MyLog, NumberID, ord(gNumberSlices)); end; if item = BordersID then begin gBorders := not gBorders; SetDlogItem(MyLog, BordersID, ord(gBorders)); end; until (item = ok) or (item = cancel); DisposeDialog(mylog); if item = cancel then exit(MakeMontage); if (scale <= 0.05) or (scale > 5) then scale := SaveScale; dWidth := round(StackWidth * scale); dHeight := round(StackHeight * scale); mWidth := nColumns * dWidth; mHeight := nRows * dHeight; StackInfo := info; Background := MyGetPixel(0, 0); SetBackgroundColor(Background); if Background = WhiteIndex then SetForegroundColor(BlackIndex) else SetForegroundColor(WhiteIndex); if not NewPicWindow('Montage', mWidth, mHeight) then exit(MakeMontage); MontageInfo := info; SaveGDevice := GetGDevice; SetGDevice(osGDevice); SetPort(GrafPtr(info^.osPort)); pmForeColor(ForegroundIndex); dPort := info^.osPort; dLeft := 0; dTop := 0; sPort := StackInfo^.osPort; sRect := StackInfo^.PicRect; i := FirstSlice; while i <= LastS ck; UpdateTitleBar; end; ResetGrayMap; end; procedure CopyGWorldToStack; {Copies the color image stored in the 32-bit GWorld used by QuickTime video digitizers to a 3 slice (RGB) stack.} type LongPtr = ^LongInt; var row, i, width, WatchRate: integer; RedLine, GreenLine, BlueLine: LineType; Pixel, RowOffset: LongInt; pmapPtr: ptr; LPtr, RowStart: LongPtr; begin if fgPixMap^^.pixelSize <> 32 then begin PutError('RGB capture requires a 24-bit digitizer.'); DigitizerMode := digitizeColor; exit(CopyGWorldToStack); end; if not MakeRGBStack(StringOf('RGB-', nPics:1)) then exit(CopyGWorldToStack); with info^ do begin pmapPtr := GetPixBaseAddr(fgPixMap); if pmapPtr = nil then exit(CopyGWorldToStack); LPtr := LongPtr(pmapPtr); RowStart := LPtr; RowOffset := band(fgPixMap^^.RowBytes, $3FFF); width := PicRect.right; WatchRate := 40000 div PixelsPerLine; for row := 0 to nLines - 1 do begin if (row mod WatchRate) = 0 then ShowAnimatedWatch; LPtr := RowStart; for i := 0 to PixelsPerLine - 1 do begin pixel := BitNot(LPtr^); blueLine[i] := band(pixel, 255); pixel := bsr(pixel, 8); greenLine[i] := band(pixel, 255); pixel := bsr(pixel, 8); redLine[i] := band(pixel, 255); LPtr := LongPtr(ord4(LPtr) + 4); end; RowStart := LongPtr(ord4(RowStart) + RowOffset); SelectSlice(1); PutLine(0, row, width, RedLine); SelectSlice(2); PutLine(0, row, width, GreenLine); SelectSlice(3); PutLine(0, row, width, BlueLine); end; with Info^.StackInfo^ do begin CurrentSlice := 1; SelectSlice(CurrentSlice); StackType := rgbStack; UpdateTitleBar; end; ResetGrayMap; end; {with} end; procedure CaptureVDigColor; var err: OSErr; pRect: rect; thePictInfo: PictInfo; SaveGDevice: GDHandle; begin if DigitizerMode = digitizeGrayscale then begin PutError('To capture color, "8-bit Color" or "RGB Color" must be selected in Video Control.'); exit(CaptureVDigColor); end; if not digitizing then begin if info^.PictureType <> FrameGrabberType then SelectCameraWindow; CaptureAndDisplayFrame; end; if fgPixMap = nil then exit(CaptureVDigColor); SaveGDevice := GetGDevice; err := GetPixMapInfo(fgPixMap, thePictInfo, ReturnColorTable, 256, SystemMethod, 0); if err = noErr then begin LoadColorTable(thePictInfo.theColorTable); SetForegroundColor(BlackIndex); SetBackgroundColor(WhiteIndex); SetGDevice(osGDevice); SetPort(GrafPtr(Info^.osPort)); with info^ do CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, picRect, picRect, DitherCopy, nil); SetGDevice(SaveGDevice); UpdatePicWindow; DrawLUT; end; if DigitizerMode = digitizeRGB then CopyGWorldToStack; end; procedure CaptureColor; var MainDevice: GDHandle; SourcePixMap: PixMapHandle; frame, width, height, SaveChannel: integer; frect: rect; begin with info^ do if PictureType <> FrameGrabberType then begin PutError('You must be capturing to capture color.'); AbortMacro; exit(CaptureColor); end; StopDigitizing; if frameGrabber = QTvdig then begin CaptureVDigColor; exit(CaptureColor); end; with info^.PicRect do begin width := right - left; height := bottom - top; end; if Activate('RGB') then with info^.PicRect do begin if ((right - left) <> width) or ((bottom - top) <> height) then if not MakeRGBStack('RGB') then exit(CaptureColor); end else if not MakeRGBStack('RGB') then exit(CaptureColor); ShowWatch; SourcePixMap := fgPixMap; ResetFrameGrabber; with frect do begin left := 0; top := 0; right := left + width; bottom := top + height; end; ShowTriggerMessage; SaveChannel := VideoChannel; with info^, info^.StackInfo^ do begin for frame := 1 to 3 do begin if FrameGrabber = QuickCapture then begin case frame of 1: VideoChannel := 1; {Green} 2: VideoChannel := 0; {Red} 3: VideoChannel := 2; {Blue} end; ResetFrameGrabber; repeat until band(ControlReg^, $8) = 0; {mux channel not busy} end else begin VideoChannel := frame - 1; ResetFrameGrabber; end; if VideoControl <> nil then ShowChannel; CurrentSlice := frame; SelectSlice(CurrentSlice); GetFrame; CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); end; {for} CurrentSlice := 1; SelectSlice(CurrentSlice); UpdateTitleBar; end; {with} VideoChannel := SaveChannel; if VideoControl <> nil then ShowChannel; ConvertRGBToEightBitColor(true); end; procedure AverageSlices; const MaxWidth = 2048; var slices, sRow, aRow, slice, i, SaveSlice: integer; width, height, hstart, vStart: integer; OldInfo, NewInfo: InfoPtr; aLine: LineType; mask: rect; sum: array[0..MaxWidth] of LongInt; AutoSelectAll: boolean; SlicesDiv2:LongInt; begin OldInfo := Info; with info^ do begin if StackInfo = nil then begin PutError('Average Slices requires a stack.'); AbortMacro; exit(AverageSlices); end; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); with RoiRect do begin hStart := left; vStart := top; width := right - left; height := bottom - top; end; if width > MaxWidth then begin PutError(concat('NIH Image can''t average selections wider than ', Long2str(MaxWidth), ' pixels.')); AbortMacro; exit(AverageSlices); end; with StackInfo^ do begin slices := StackInfo^.nSlices; SaveSlice := CurrentSlice; end; if not NewPicWindow('Average', width, height) then begin AbortMacro; exit(AverageSlices); end; end; info^.changes := true; NewInfo := Info; aRow := 0; SlicesDiv2:=slices div 2; {Needed for rounding} for sRow := vStart to vStart + height - 1 do begin info := OldInfo; for i := 0 to width - 1 do sum[i] := 0; for slice := 1 to slices do begin SelectSlice(slice); GetLine(hStart, sRow, width, aLine); for i := 0 to width - 1 do sum[i] := sum[i] + aLine[i]; end; for i := 0 to width - 1 do aLine[i] := (sum[i]+SlicesDiv2) div slices; info := NewInfo; PutLine(0, aRow, width, aLine); SetRect(mask, 0, aRow, width, aRow + 1); aRow := aRow + 1; UpdateScreen(mask); if CommandPeriod then leave; end; info := OldInfo; SelectSlice(SaveSlice); if AutoSelectAll then KillRoi; info:=NewInfo; end; procedure ConvertRGBToHSV; const MaxSaturation = 255; MaxValue = 255; var width, height, i, row, mark: integer; rLine, gLine, bLine, hLine, sLine, vLine: LineType; delta, min, max, R, G, B, H, S, V: integer; tmp: longint; UpdateR: rect; function Max3 (a, b, c: integer): integer; var TempMax: integer; begin if (a > b) then TempMax := a else TempMax := b; if (TempMax > c) then Max3 := TempMax else Max3 := c; end; function Min3 (a, b, c: integer): integer; var TempMin: integer; begin if (a < b) then TempMin := a else TempMin := b; if (TempMin < c) then Min3 := TempMin else Min3 := c; end; begin with info^ do begin if StackInfo^.nSlices <> 3 then begin PutError('RGB to HSV color conversion requires a three slice(red, green and blue) stack as input.'); exit(ConvertRGBToHSV); end; if Changes then begin if PutMessageWithCancel('RGB to HSV color conversion is undoable.') = cancel then exit(ConvertRGBToHSV); end; KillRoi; with StackInfo^ do begin CurrentSlice := 1; SelectSlice(CurrentSlice); UpdatePicWindow; end; SwitchColorTables(SpectrumItem, true); title := 'HSV'; UpdateTitleBar; width := PixelsPerLine; height := nLines; mark := 0; ShowWatch; for row := 0 to height - 1 do begin SelectSlice(1); GetLine(0, row, width, rLine); SelectSlice(2); GetLine(0, row, width, gLine); SelectSlice(3); GetLine(0, row, width, bLine); for i := 0 to width - 1 do begin R := 255 - rLine[i]; G := 255 - gLine[i]; B := 255 - bLine[i]; max := Max3(R, G, B); min := Min3(R, G, B); V := max; if max <> 0 then begin tmp := 255 * (max - min); S := (tmp + (tmp mod max)) div max; {adding '(tmp mod max)' simulate rounding} end else S := 0; if S = 0 then H := 0 {undefined but, but select red } else begin delta := max - min; if R = max then begin tmp := 85 * (G - B); H := tmp div delta; end else if G = max then begin tmp := 85 * (B - R); H := 170 + tmp div delta; end else if B = max then begin tmp := 85 * (R - G); H := 340 + tmp div delta; end; H := H div 2; if H < 0 then H := H + 255 end; if H = 0 then hLine[i] := 1 else hLine[i] := H; sLine[i] := S; vLine[i] := 255 - V; end; SelectSlice(1); PutLine(0, row, width, hLine); if (row mod 10) = 0 then begin setrect(UpdateR, 0, mark, width - 1, row); mark := row; UpdateScreen(UpdateR); end; SelectSlice(2); PutLine(0, row, width, sLine); SelectSlice(3); PutLine(0, row, width, vLine); end; SelectSlice(1); StackInfo^.StackType := hsvStack; UpdateTitleBar; end; {with} WhatToUndo := NothingToUndo; end; procedure DoStackInfo; const VolumeID = 5; MovieID = 6; RGBID = 7; HSVID = 8; SpacingID = 11; IntervalID = 12; var mylog: DialogPtr; item: integer; spacing, SaveSpacing, SaveInterval: extended; SaveType: StackTypeType; str: str255; procedure ShowStackType; begin With info^.StackInfo^ do begin SetDlogItem(MyLog, VolumeID, ord(StackType = VolumeStack)); SetDlogItem(MyLog, MovieID, ord(StackType = MovieStack)); SetDlogItem(MyLog, RGBID, ord(StackType = rgbStack)); SetDlogItem(MyLog, HSVID, ord(StackType = hsvStack)); end; end; begin With info^, info^.StackInfo^ do begin InitCursor; mylog := GetNewDialog(280, nil, pointer(-1)); SaveType := StackType; SaveSpacing := SliceSpacing; SaveInterval := Frameinterval; ShowStackType; if SpatiallyCalibrated then begin spacing := SliceSpacing / xScale; str := xunit; end else begin spacing := SliceSpacing; str := 'pixels' end; SetDReal(MyLog, SpacingID, spacing, 3); ParamText(str, '', '', ''); if Frameinterval < 99.0 then SetDReal(MyLog, IntervalID, Frameinterval, 3) else SetDReal(MyLog, IntervalID, Frameinterval, 0); SelectDialogItemText(MyLog, SpacingID, 0, 32767); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if (item >= VolumeID) and (item <= HSVID) then begin case item of VolumeID: StackType := VolumeStack; MovieID: StackType := MovieStack; rgbID: StackType := rgbStack; hsvID: StackType := hsvStack; end; ShowStackType; end; if item = SpacingID then begin spacing := GetDReal(MyLog, SpacingID); if SpatiallyCalibrated then SliceSpacing := spacing * xScale else SliceSpacing := spacing; end; if item = IntervalID then Frameinterval := GetDReal(MyLog, IntervalID); until (item = ok) or (item = cancel); DisposeDialog(mylog); if item = cancel then begin StackType := SaveType; SliceSpacing := SaveSpacing; Frameinterval := SaveInterval; end else if ((StackType = rgbStack) or (StackType = hsvStack)) and (nSlices <> 3) then begin PutError('RGB and HSV stacks must have three slices.'); StackType := SaveType; end; end; {with} UpdateTitleBar; end; end. 
